perm filename XYZ[G,BGB] blob
sn#025304 filedate 1973-02-16 generic text, type T, neo UTF8
00100 TITLE XAP - XEROX ASSEMBLE AND PRINT - BGB - 27 JANUARY 1973.
00200
00300
00400 COMMENT/
00500 PHYSICAL PAGE SIZE 8.5" BY 11"
00600 PRINTIBLE PAGE SIZE 7.5" BY 10"
00700 7.5" IS 40 WORDS PER LINE IS 1440 XCOLUMNS.
00800 10" IS 2000 XROWS.
00900 BUFFER SIZE IS (41 WORDS PER ROW)*(2000 ROWS) = 82000 WORDS.
01000
01100 FONT FILE AND UPPER SEGMENT FORMAT.
01200
01300 00 ↔ GLYPH1 ↔ BLOCK 176 ; =128 WORD GLYPH POINTER TABLE.
01400
01500 GLYPH1: XWD ROWS,WORDS ;ROWS IN THE GLYPH, WORD WIDTH OF GLYPH.
01600 XWD R0,C0 ;GLYPH ORIGIN RELATIVE TO PEN POSITION.
01700 XWD R1,C1 ;GLYPH TERMINUS RELATIVE TO PEN POSITION.
01800 BLOCK ROWS*WORDS
01900 /
02000
02100 DECLARE{ORGBUF,ENDBUF,ROW,COL,DROW,DCOL}
02200 O(CORE, CALLI 11)
02300 O(ATTSEG,CALLI 400016)
02400 O(DETSEG,CALLI 400017)
02500 O(SEGNUM,CALLI 400021)
02600 O(CORE2, CALLI 400015)
02700 $←←400000
02800 MAXFILES←←5 ;NUMBER OF INDIRECTED FILES
02900 MAXFONT←←=9 ;NUMBER OF FONTS
03000 ROWINC←←=41 ;SIZE OF ROW IN WORDS
03100 COLEND←←(ROWINC-1)*=36
03200 ROWEND←←=2000
03300 BUFSIZ←←ROWINC*ROWEND
03400
03500 EXTERNAL JOBJDA,JOBFF,JOBSA
00100 SUBR(MKBUF)-------------------------------------------------------
00200 BEGIN MKBUF;MAKE XGP BUFFER - BGB - 27 JANUARY 1973.
00300
00400 ;EXPAND CORE FOR XGP BUFFER.
00500 LAC JOBFF↔DAC ORGBUF
00600 ADDI BUFSIZ↔DAC ENDBUF↔AOS ORGBUF
00700 ADDI 10↔DAC JOBFF↔IORI 1777
00800 CALLI 11↔GO [FATAL(CAN'T GET CORE FOR XGP BUFFER)]
00900
01000 ;CLEAR XGP BUFFER.
01100 LAC 1,ORGBUF↔SETZM(1)
01200 DIP 1,1↔AOS 1
01300 CDR 2,ENDBUF↔BLT 1,(2)
01400 POP0J
01500
01600 BEND;1/27/73------------------------------------------------------
00100 SUBR(XGPOUT)------------------------------------------------------
00200 BEGIN XGPOUT
00300
00400 ;PUT CONTROL WORD IN EACH ROW.
00500 LAC[1B11+=100B23+=40]
00600 LAC 1,ORGBUF
00700 LACI 2,ROWEND ;NUMBER OF ROWS.
00800 DAC(1)↔ADDI 1,ROWINC ;ROW WORD WIDTH.
00900 SOJG 2,.-2
01000
01100 ;CALL THE IOTS.
01200 LAC ORGBUF↔SOS↔DAP OUT2
01300 INIT 2,17↔SIXBIT/XGP/↔0↔HALT
01400 SETZ 1,
01500 SEGNUM 1,
01600 DETSEG
01700 OUTSTR[ASCIZ/OUTPUTING PAGE TO XGP.../]
01800 OUT 2,OUT1
01900 RELEASE 2,
02000 OUTSTR[ASCIZ/PAGE FINISHED.
02100 /]
02200 JUMPE 1,.+3
02300 ATTSEG 1,
02400 GO [OUTSTR[ASCIZ/OOPS, MY SEGMENT WENT AWAY. /]
02500 HALT .+1]
02600
02700 ;CLEAR XGP BUFFER.
02800 LAC 1,ORGBUF↔SETZM(1)
02900 DIP 1,1↔AOS 1
03000 CDR 2,ENDBUF↔BLT 1,(2)
03100 POP0J
03200
03300 ;-----------------------------------------------------------------
03400 OUT1: IOWD 2,HACK1
03500 OUT2: IOWD BUFSIZ,0
03600 OUT3: IOWD 2,HACK2
03700 0
03800
03900 HACK1: 1B0
04000 1B0 + =80B11
04100 HACK2: 1B0 + =80B11
04200 0↔0
04300 BEND;1/31/73------------------------------------------------------
00100 SUBR(PLAG)GLYPH---------------------------------------------------
00200 BEGIN PLAG;PLACE A GLYPH INTO THE XGP BUFFER AT ROW,COL.
00300 ;BGB - 27 JANUARY 1973.
00400
00500 ACCUMULATORS{G,B,B2,M,N,I}
00600 LAC G,ARG1
00700
00800 ;ORIGIN AND BUFFER POINTER.
00900
01000 NIP 1(G)↔ADD ROW↔DAC ROW
01100 IMULI =41↔ADD ORGBUF↔DAPZ B
01200
01300 NAP 1(G)↔ADD COL↔DAC COL
01400 IDIVI =36↔AOS
01500 ADD B,0↔MOVNS 1↔DAP 1,L3
01600
01700 CAR M,0(G)↔CDR N,0(G)
01800 DIP G,G↔ADDI G,3
01900 DAC B,B2
02000
02100 ;INCLUSIVE OR GLYPH BITS INTO THE XGP BUFFER.
02200
02300 L1: LAC I,N
02400 L2: LAC 0,(G)↔SETZ 1,
02500 L3: LSHC 0,0
02600 CAML B,ORGBUF↔CAMLE B,ENDBUF↔SKIPA↔IORM 0,(B)
02700 AOS B
02800 CAML B,ORGBUF↔CAMLE B,ENDBUF↔SKIPA↔IORM 1,(B)
02900 AOS G
03000 SOJG I,L2↔LAC B,B2
03100 ADDI B,ROWINC↔DAC B,B2
03200 SOJG M,L1↔LIP G,G
03300
03400 ;TERMINUS.
03500
03600 NIP 2(G)↔ADD ROW↔DAC ROW
03700 NAP 2(G)↔ADD COL↔DAC COL
03800 POP1J
03900 BEND;1/27/73------------------------------------------------------
00100 SUBR(PLTVEC,XN,YN)------------------------------------------------
00200 BEGIN PLTVEC
00300 ACCUMULATORS {DX,DY,D,E,F,T,X0,Y0,ONE,MOVE1}
00400 PTR←1
00500 MOVE X0,COL
00600 MOVE Y0,ROW
00700 MOVE -2(P)
00800 CAIL COLEND
00900 GO [ OUTSTR[ASCIZ/VECTOR OFF SCREEN → /]
01000 POP2J ]
01100 JUMPL [ OUTSTR[ASCIZ/VECTOR OFF SCREEN ← /]
01200 POP2J ]
01300 MOVEM COL
01400 MOVE -1(P)
01500 CAML ROWMAX
01600 GO [ OUTSTR[ASCIZ/VECTOR OFF SCREEN ↓ /]
01700 POP2J ]
01800 JUMPL [ OUTSTR[ASCIZ/VECTOR OFF SCREEN ↑ /]
01900 POP2J ]
02000 MOVEM ROW
02100 CAMLE X0,-2(P)↔GO[EXCH X0,-2(P)↔EXCH Y0,-1(P)↔GO C1]
02200 C1: MOVE PTR,X0
02300 IDIVI PTR,=36
02400 MOVN DX,DX
02500 DPB DX,[POINT 6,PTR,5]
02600 ADD PTR,[XWD 440100,0]
02700 MOVE DX,Y0
02800 IMULI DX,ROWINC
02900 ADD PTR,DX
03000 ADD PTR,ORGBUF
03100 ADDI PTR,1
03200 DPB ONE,PTR
03300 C0: MOVEI ONE,1 ;INITIALIZE CONSTANT FOR LOOP
03400 MOVE DX,-2(P)↔SUB DX,X0 ;DX←XN-X0;
03500 MOVE DY,-1(P)↔SUB DY,Y0 ;DY←YN-Y0;
03600 SKIPN DX
03700 JUMPE DY,POP2J.
03800 MOVE D,DX↔ADD D,DY ;D←DX+DY;
03900 MOVE T,DY↔SUB T,DX ;T←DY-DX;
04000 SETZ MOVE1, ;MOVE1←0;
04100 SKIPL DY ;IF DY≥0
04200 MOVEI MOVE1,2 ; THEN MOVE1←2;
04300 SKIPL D ;IF D≥0
04400 ADDI MOVE1,2 ; THEN MOVE1←MOVE1+2;
04500 SKIPL T ;IF T≥0
04600 ADDI MOVE1,2 ; THEN MOVE1←MOVE1+2;
04700 JUMPGE DX,[MOVN MOVE1,MOVE1 ;IF DX≥0 THEN MOVE1←8-MOVE1
04800 ADDI MOVE1,=8
04900 GO C2] ;
05000 ADDI MOVE1,=10 ; ELSE MOVE1←MOVE1+10;
05100 C2: MOVM DX,DX ;DX←ABS(DX);
05200 MOVM DY,DY ;DY←ABS(DY);
05300 MOVE F,DX↔ADD F,DY ;F←DX+DY;
05400 MOVE D,DY↔SUB D,DX ;D←DY-DX;
05500 JUMPGE D,[MOVE T,DX ;IF D≥0 THEN BEGIN T←DX;
05600 MOVN D,D↔GO C3] ; D←-D; END
05700 MOVE T,DY ; ELSE T←DY;
05800 C3: SETZ E, ;E←0;
05900 LOOP: MOVE DX,D↔ADD DX,E ;DX←D+E;
06000 MOVE DY,T↔ADD DY,E
06100 ADD DY,DX ;DY←T+E+DX;
06200 JUMPGE DY,[MOVE E,DX ;IF DY≥0 THEN BEGIN E←DX;
06300 SUBI F,1 ; F←F-1; COMMENT F←F-1 IS DONE OUTSIDE IF;
06400 JRST @CODE(MOVE1)]; PLOT(MOVE1); END
06500 ADD E,T ; ELSE BEGIN E←E+T; COMMENT F←F-1 IS LATER;
06600 JRST @CODE-1(MOVE1) ; PLOT(MOVE1-1); END
06700 C4: SOJG F,LOOP ;IF F>0 THEN GO LOOP; COMMENT F←F-1 IS DONE HERE;
06800 POP2J
06900 CODE: C
07000 @C+1↔@C+2↔@C+3↔@C+2↔@C+3↔@C+4↔@C+5↔@C+4
07100 @C+5↔@C+6↔@C+7↔@C+6↔@C+7↔@C+8↔@C+1↔@C+8
07200 C: HALT .
07300 [ADDI PTR,ROWINC↔DPB ONE,PTR↔SOJG F,LOOP↔POP2J] ;1 +Y
07400 [ADDI PTR,ROWINC↔IDPB ONE,PTR↔SOJG F,LOOP↔POP2J] ;2 +X+Y
07500 [IDPB ONE,PTR↔SOJG F,LOOP↔POP2J] ;3 +X
07600 [SUBI PTR,ROWINC↔IDPB ONE,PTR↔SOJG F,LOOP↔POP2J] ;4 +X-Y
07700 [SUBI PTR,ROWINC↔DPB ONE,PTR↔SOJG F,LOOP↔POP2J] ;5 -Y
07800 HALT . ;6 -X-Y
07900 HALT . ;7 -X
08000 HALT . ;8 -X+Y
08100 BEND;2/8/73/(TVR)-------------------------------------------------
00100 SUBR(IIISIM)OUTPUT III BUFFER ONTO XGP----------------------------
00200 BEGIN IIISIM
00300 EXTERNAL FIXDPY
00400 ; CALL(GETCHM)↔ASH 1,5↔MOVEM 1,MULFAC#
00500 CALL(GETCHM)↔IMULI 1,COLEND↔ASH 1,-6↔MOVEM 1,MULFAC#
00600 CALL(GETFIL)↔POP0J
00700 CALL(INITIO,[17],[SIXBIT/DSK/],[0])
00800 GO[FATAL(CAN'T INIT DSK)]
00900 MOVEM 1,IIICHN#
01000 CALL(IO,[LOOKUP FILNAM],IIICHN)
01100 GO FRET
01200 HLRE 1,PPPN
01300 MOVN 1,1
01400 ADD 1,JOBFF
01500 MOVEM 1,BUFEND#
01600 CORE 1,
01700 GO [FATAL(CAN'T EXPAND CORE)]
01800 MOVE JOBFF
01900 ADDM PPPN
02000 CALL(IO,[IN PPPN],IIICHN)
02100 CALL(FIXDPY,JOBFF)
02200 MOVE COL
02300 MOVEM BEGCOL#
02400 MOVE ROW
02500 MOVEM BEGROW#
02600 MOVE 1,JOBFF
02700 ADDI 1,2
02800 MOVEM 1,PC#
02900 OUTSTR[ASCIZ/READING III BUFFER.../]
03000 ILOOP: AOSA 1,PC
03100 LOOP: MOVE 1,PC
03200 CAML 1,BUFEND↔GO RET
03300 MOVE 2,(1)
03400 TRNE 2,1 ;TEXT?
03500 GO [ PUSH P,2 ;-2(P)
03600 PUSH P,[5] ;-1(P)
03700 PUSH P,[POINT 7,-2(P)] ; 0(P)
03800 CLOOP: ILDB 1,(P)
03900 JUMPE 1,CCONT
04000 CAIN 1,15
04100 GO [ MOVE -4(P)
04200 MOVEM COL
04300 GO CCONT]
04400 CALL (PLAG)
04500 CCONT: SOSL -1(P)
04600 GO CLOOP
04700 SUB P,[XWD 3,3]
04800 GO ILOOP]
04900 TRNE 2,2 ;VECTORS?
05000 GO [ TRNN 2,4
05100 GO [TRNN 2,10 ;SHORT VECTOR OR TSS
05200 GO SVECT ;SHORT VECTOR
05300 GO ILOOP] ;TSS
05400 LDB [POINT 11,2,10] ;LONG VECTOR
05500 ROT -13
05600 PUSHJ P,GRONK
05700 LDB [POINT 11,2,21]
05800 ROT -13
05900 MOVN
06000 PUSHJ P,GRONK
06100 LDB 1,[POINT 3,2,31]
06200 PUSHJ P,@PLOTAB(1)
06300 GO ILOOP]
06400 TRNE 2,20
06500 GO [ TRNN 2,4
06600 GO [ HLRZ 1,2 ;JUMP
06700 MOVEM 1,PC
06800 GO LOOP]
06900 TRNE 2,40
07000 GO LOOP ;SAVE A NOP HERE
07100 AOS 1,PC ;JMS
07200 HRLI 1,20
07300 HLRZ 2,2
07400 MOVEM 1,(2)
07500 MOVEM 2,PC
07600 GO ILOOP]
07700 TRNE 2,37 ;HALT?
07800 GO ILOOP ;NO, REST A NOP HERE
07900 RET: AOS (P) ;YES, RETURN
08000 OUTSTR [ASCIZ/FINISHED
08100 /]
08200 FRET: CALL(IO,[RELEASE],IIICHN)
08300 MOVE 1,JOBFF
08400 CORE 1,
08500 GO [FATAL(CAN'T SHRINK CORE!)]
08600 MOVE BEGCOL
08700 MOVEM COL
08800 MOVE BEGROW
08900 MOVEM ROW
09000 POP0J
09100 SVECT: PUSH P,2
09200 LDB [POINT 7,2,6]
09300 ROT -7
09400 PUSHJ P,GRONK
09500 LDB [POINT 7,2,13]
09600 ROT -7
09700 MOVN
09800 PUSHJ P,GRONK
09900 LDB 1,[POINT 2,2,15]
10000 PUSHJ P,@PLOTAB(1)
10100 POP P,2
10200 LDB [POINT 7,2,22]
10300 ROT -7
10400 PUSHJ P,GRONK
10500 LDB [POINT 7,2,29]
10600 ROT -7
10700 PUSHJ P,GRONK
10800 LDB 1,[POINT 2,2,31]
10900 PUSHJ P,@PLOTAB(1)
11000 GO ILOOP
11100 GRONK: ADD [XWD 200000,0]
11200 MUL MULFAC
11300 EXCH 0,(P)
11400 JRST @0
11500 PLOTAB: [RVECT: CALL(RELATE)↔CALL(PLTVEC,1,2)↔POP2J]
11600 [RPNT: CALL(RELATE)↔MOVEM 1,COL↔MOVEM 2,ROW↔GO PLTVEC]
11700 [RIVECT: CALL(RELATE)↔MOVEM 1,COL↔MOVEM 2,ROW↔POP2J]
11800 RPNT
11900 [AVECT: CALL(ABSOLUTE)↔GO PLTVEC] ;ARGS ARE ALREADY STACKED
12000 [APNT: CALL(ABSOLUTE)↔MOVEM 1,COL↔MOVEM 2,ROW↔GO PLTVEC]
12100 [AIVECT: CALL(ABSOLUTE)↔MOVEM 1,COL↔MOVEM 2,ROW↔POP2J]
12200 APNT
12300 RELATE: MOVSI -200000↔MUL MULFAC↔MOVE 1,0↔ADD 1,COL↔ADDB 1,-3(P)
12400 MOVE 2,0↔ADDB 2,-2(P)↔ADD 1,ROW↔POP0J
12500 ABSOLU: MOVE 1,BEGCOL↔ADDB 1,-3(P)↔MOVE 2,BEGROW↔ADDB 2,-2(P)↔POP0J
12600 BEND;2/8/73/(TVR)-------------------------------------------------
00100 SUBR(GETFIL)GET FILE SPEC FROM TTY LINE - BGB - 10 DEC 72.--------
00200 BEGIN GETFIL
00300
00400 SETZM FILNAM↔SETZM EXTION
00500 SETZM EXTION+1↔SETZM PPPN
00600 ; CRLF
00700 LAC 4,[POINT 6,FILNAM,-1]↔LACI 2,6
00800 CALL(GETCHR)↔POP0J↔CAIN 1,15↔GO[CALL(GETCHR)↔POP0J↔POP0J]↔AOS(P)
00900 JRST L+2
01000 L: CALL(GETCHR)↔POP0J
01100 CAILE 1,"z"↔POP0J
01200 CAIL 1,"a"↔SUBI 1,40 ;CONVERT LOWER CASE
01300 CAIN 1,"."↔GO[LAC 4,[POINT 6,EXTION,-1]↔LACI 2,3↔GO L]
01400 CAIN 1,"["↔GO[LAC 4,[POINT 6,PPPN,-1] ↔LACI 2,3↔GO L]
01500 CAIN 1,","↔GO[HLRZ PPPN
01600 PUSHJ P,[PPJUST: JUMPE [OUTSTR[ASCIZ/BAD P,PN/]
01700 CLRBFI↔SOS -1(P)↔CRLF↔POP1J]
01800 TRNE 77↔POP0J↔LSH -6↔GO PPJUST]
01900 HRLM PPPN↔LAC 4,[POINT 6,PPPN,17]↔LACI 2,3↔GO L]
02000 CAIN 1,"]"↔GO[HRRZ PPPN↔CALL(PPJUST)
02100 HRRM PPPN↔CALL(GETCHR)↔POP0J↔GO FINQ]
02200 FINQ: CAIN 1,15↔GO EOL ;END OF THE LINE.
02300 CAIN 1,12↔POP0J
02400 CAIN 1,"→"↔POP0J
02500 CAIG 1," "↔GO L ;IGNORE GARBAGE.
02600 SOJL 2,L↔SUBI 1,40↔IDPB 1,4↔GO L
02700
02800 EOL: CALL(GETCHR)↔POP0J↔POP0J
02900 BEND;1/31/73,2/7/73(TVR)----------------------------------------------
00100 SUBR(INITIO)GET AND OPEN A CHANNEL--------------------------------
00200 BEGIN INITIO
00300 MOVEI 1,17 ;SEARCH FOR FREE CHANNEL
00400 SKIPE JOBJDA(1)
00500 SOJGE 1,.-1
00600 JUMPL 1,[OUTSTR[ASCIZ+OUT OF I/O CHANNELS!
00700 +]
00800 POP3J]
00900 MOVE [ OPEN -3(P)]
01000 DPB 1,[POINT 4,0,12]
01100 XCT 0
01200 POP3J
01300 AOS (P)
01400 POP3J
01500 BEND;2/7/73/(TVR)-------------------------------------------------
01600
01700 SUBR(IO,OPCODE,CHAN)----------------------------------------------
01800 BEGIN IO
01900 MOVE -1(P)
02000 DPB [POINT 4,-2(P),12]
02100 XCT -2(P)
02200 POP2J
02300 AOS (P)
02400 POP2J
02500 BEND;2/7/73/(TVR)-------------------------------------------------
00100 SUBR(GETCHR)GET CHARACTER AND SKIP.-------------------------------
00200 BEGIN GETCHR
00300 SKIPE TTYFLAG↔GO[INCHWL 1↔AOS(P)↔POP0J]
00400 SKIPGE 1,IOPTR↔POP0J
00500 SOSLE IBUF+2(1)
00600 GO[RETCHR: ILDB 1,IBUF+1(1)↔AOS(P)↔POP0J]
00700 CALL(IO,[IN],<CHANTB(1)>)
00800 GO RETCHR
00900 CALL(IO,[STATO 1B22],<CHANTB(1)>)
01000 GO [OUTSTR[ASCIZ/READ ERROR /]
01100 HALT RETCHR]
01200 CALL(IO,[RELEASE],<CHANTB(1)>) ;EOF.
01300 SUBI 1,4
01400 DAC 1,IOPTR
01500 GO GETCHR
01600 POP0J
01700 BEND;2/7/73(TVR)--------------------------------------------------
01800
01900 SUBR(GETCHM)GET CHARACTER AND BARF IF EOF AND NO I/O LEFT---------
02000 BEGIN GETCHM
02100 CALL(GETCHR)
02200 GO [FATAL(UNEXPECTED EOF)]
02300 POP0J
02400 BEND;2/7/73(TVR)--------------------------------------------------
02500
02600 SUBR(RDNUM)-------------------------------------------------------
02700 BEGIN RDNUM;
02800 CALL(GETCHM)↔HRREI 2,-100(1)↔ASH 2,7↔CALL(GETCHM)↔MOVE 0,2
02900 ADD 1↔POP0J
03000 BEND RDNUM;-------------------------------------------------------
03100
03200 SUBR(RDPAIR)------------------------------------------------------
03300 BEGIN RDPAIR;
03400 CALL(RDNUM)↔MOVE 3,0↔JUMPL XLOSE↔CAILE COLEND
03500 GO[XLOSE: CALL(RDNUM)↔POP0J]
03600 CALL(RDNUM)↔JUMPL YLOSE↔CAILE ROWEND
03700 GO[YLOSE: POP0J]
03800 AOS(P)↔POP0J
03900 BEND RDPAIR;------------------------------------------------------
00100 SUBR(INITXT)INITIALIZE TEXT FILE----------------------------------
00200 BEGIN INITXT
00300 LACI 2,4↔ADD 2,IOPTR
00400 CAIL 2,4*MAXFILES↔GO[FATAL(TOO MANY INDIRECT FILES!)]
00500 LACI IBUF(2)
00600 CALL (INITIO,[0],[SIXBIT/DSK/],0)↔GO[FATAL(CAN'T INIT DSK)]
00700 DAC 1,CHANTB(2)
00800 SKIPE TTYFLAG↔OUTSTR [ASCIZ/TEXT: /]
00900 CALL(GETFIL)↔GO FRET
01000 CAIE 1,12↔GO[OUTSTR[ASCIZ/ILLEGAL FILE TERMINATOR:/]
01100 OUTCHR 1↔GO FRET]
01200 LACI 2,4↔ADDB 2,IOPTR
01300 CALL (IO,[LOOKUP FILNAM],<CHANTB(2)>)
01400 GO[OUTSTR[ASCIZ/FILE NOT FOUND.
01500 /]
01600 FRET: LACI 2,4↔SUBM 2,IOPTR↔CALL(IO,[RELEASE],<CHANTB(2)>)
01700 POP0J]
01800 AOS(P)
01900 POP0J
02000 BEND;2/7/73(TVR)--------------------------------------------------
00100 SUBR(DEFONT)DEFINE A FONT ----------------------------------------
00200 BEGIN DEFONT
00300 PUSH P,[17]
00400 PUSH P,[SIXBIT/DSK/]
00500 PUSH P,[0]
00600 PUSHJ P,INITIO ;INITIALIZE
00700 GO [FATAL(CAN'T INIT DSK)]
00800 MOVEM 1,FONTCH
00900 SKIPE TTYFLAG
01000 OUTSTR [ASCIZ/FONT: /]
01100 CALL(GETFIL)↔POP0J
01200 CAIE 1,"→"↔CAIN 1,12↔GO OK
01300 OUTSTR[ASCIZ/ILLEGAL FILE TERMINATOR:/]↔CALL(ONECHR)↔CLRBFI↔GO FRET]
01400 OK: CALL (IO,[LOOKUP FILNAM],FONTCH)
01500 GO [ HRLI 'XAP'↔SKIPN EXTION↔HLLZM EXTION
01600 CALL (IO,[LOOKUP FILNAM],FONTCH)
01700 GO [ MOVE FNTPPN↔SKIPN PPPN↔MOVEM PPPN
01800 CALL (IO,[LOOKUP FILNAM],FONTCH)
01900 GO [ OUTSTR[ASCIZ/NOT FOUND, TRY AGAIN
02000 /]
02100 POP0J]
02200 GO .+1]
02300 GO .+1]
02400 CAIN 1,"→"↔GO [ CALL(GETCHM) ;DEFINING FONT NUMBER ≠0?
02500 CAIL 1,"0"↔CAIL 1,"0"+MAXFONT
02600 GO [OUTSTR[ASCIZ/ILLEGAL FONT NUMBER:/]
02700 CLRBFI↔CALL(ONECHR)↔CRLF↔GO FRET]
02800 INCHSL↔JFCL↔CAIE 12↔INCHSL↔JFCL
02900 SUBI 1,"0"↔GO CONT]
03000 SETZ 1,
03100 ↑RPGFNT: ;ENTRY FOR RPG MODE
03200 CONT: DAC 1,FONTNO
03300 SETZ↔SEGNUM ;GET SEGMENT NUMBER
03400 CAMN FONTAB(1)↔GO SEGOK ;IF SAME AS TABLE, WE WIN
03500 SKIPE 0↔DETSEG ;DETACH CURRENT SEGMENT IF ANY
03600 MOVE FONTAB(1) ;GET NUMBER OF DESIRED SEGMENT
03700 JUMPE SEGOK
03800 ATTSEG
03900 GO [OUTSTR[ASCIZ/OOPS, MY SEGMENT WENT AWAY! /]
04000 HALT SEGOK]
04100 SEGOK: LAC PPPN↔LAPI $↔SOS↔DAC INARG ;IOWD.
04200 MOVS PPPN↔MOVMS↔ADDI $
04300 DAC MAXADR↔CORE2↔HALT ;MAKE UPPER SEG.
04400 SKIPN FONTAB(1)↔GO[SETZ↔SEGNUM
04500 MOVEM FONTAB(1) ;REMEMBER SEG, NUMBER
04600 LAC[SIXBIT/FONT00/]↔ADD 1
04700 CALLI $+36↔JFCL↔GO RDFONT] ;NAME UPPER SEG.
04800 RDFONT: CALL (IO,[IN [INARG:0↔0]],FONTCH])
04900 LACI 1,177 ;CONSISTANCY CHECKING HERE
05000 CKLOOP: SKIPLE 2,$(1)↔GO[ADDI 2,$↔CAML 2,MAXADR↔GO BADFNT
05100 HRRZ (2)↔HRRZ 3,(2)↔IMUL 3↔ADDI $+3(2)
05200 CAML MAXADR↔GO BADFNT
05300 SOJGE 1,CKLOOP↔GO FONTOK]
05400 ADDI 2,SPTABE-SPTABL↔JUMPL 2,BADFNT↔SOJGE 1,CKLOOP
05500 FONTOK: CALL(SETFNT)
05600 AOS (P)
05700 FRET: CALL (IO,[RELEASE],FONTCH)
05800 POP0J
05900 BADFNT: OUTSTR[ASCIZ/BAD CHARACTER IN FONT #/]
06000 LACI 0,"0"↔ADD 0,FONTNO↔OUTCHR 0
06100 OUTSTR[ASCIZ/:/]↔CALL(ONECHR)↔SETZM $(1)
06200 CRLF↔SOJGE 1,CKLOOP↔GO FONTOK
06300 ↑FONTCH: 0
06400 MAXADR: 0
06500 BEND DEFONT;2/7/72(TVR)-------------------------------------------
06600 SUBR(ONECHR)------------------------------------------------------
06700 BEGIN ONECHR
06800 JUMPE 1,[OUTSTR [ASCIZ/<NULL>/]↔POP0J]
06900 CAIN 1," "↔GO[OUTSTR[ASCIZ/<SPACE>/]↔POP0J]
07000 CAIL 1,11↔CAILE 1,15↔GO[OUTCHR 1↔POP0J]
07100 OUTSTR @[[ASCIZ/<TAB>/]
07200 [ASCIZ/<LF>/]
07300 [ASCIZ/<VT>/]
07400 [ASCIZ/<FF>/]
07500 [ASCIZ/<CR>/]]-11(1)
07600 POP0J
07700 BEND ONECHR;2/7/72(TVR)-------------------------------------------
00100 SUBR(SETFNT)SETUP A FONT -----------------------------------------
00200 BEGIN SETFNT
00300 LACI =40↔DAC DROW ;LINE FEED DEFAULT.
00400 LAC 2,$+12↔JUMPN 2,[ ;LINE FEED SPECIFIED.
00500 NIP 0,$+1(2)↔NIP 1,$+2(2)
00600 ADD 0,1↔DAC 0,DROW↔GO .+1]
00700
00800 LACI =25↔DAC DCOL ;SPACE DEFAULT.
00900 LAC 2,$+40↔JUMPN 2,[ ;SPACE SPECIFIED.
01000 NAP 0,$+1(2)↔NAP 1,$+2(2)
01100 ADD 0,1↔DAC 0,DCOL↔GO .+1]
01200 POP0J
01300 BEND SETFNT;2/7/72(TVR)-------------------------------------------
00100 ;START ADDRESS ENTRY.
00200 SA: JRST NOTRPG
00300 RPGSA: SETOM RPGSW
00400 CAIA
00500 NOTRPG: SETZM RPGSW
00600 CALLI 0 ;RESET I/O AND CORE
00700 HLRZ JOBSA
00800 MOVEM JOBFF
00900 CORE ;CORE DOWN
01000 JFCL
01100 LAC 17,[IOWD 100,PDL] ;INITIALIZE TABLES
01200 SETZM FONTAB↔LAC [XWD FONTAB,FONTAB+1]↔BLT FONTAB+9
01300 SETZM LMAR↔LACI =1440↔DAC RMAR
01400
01500 ;RE-ENTRY ADDRESS.
01600 REE: LACI .↔DAC 124
01700 LACI 4↔MOVNM IOPTR
01800 SETOM TTYFLAG
01900 SKIPE RPGSW
02000 GO [ SETZM RPGSW
02100 CALL(INITIO,[0],[SIXBIT/DSK/],[IBUF])
02200 GO[FATAL(CAN'T INIT DSK!)]
02300 MOVEM 1,CHANTB
02400 CALL(IO,[LOOKUP 4],CHANTB);
02500 GO[OUTSTR[ASCIZ/TEXT FILE NOT FOUND - GETRPG
02600 /]↔ GO SA]
02700 SETZM IOPTR
02800 CALL(INITIO,[17],[SIXBIT/DSK/],[0])
02900 GO[FATAL(CAN'T INIT DSK!)]
03000 MOVEM 1,FONTCH
03100 CALL(IO,[LOOKUP 10],FONTCH);
03200 GO[OUTSTR[ASCIZ/FONT FILE NOT FOUND - GETRPG
03300 /]↔ GO SA]
03400 MOVEM 13,PPPN ;SAVE LENGTH
03500 MOVE 1,14
03600 JUMPL 1,[RPGLOSE: OUTSTR[ASCIZ/ILLEGAL FONT NUMBER
03700 /]
03800 GO SA]
03900 CAILE 1,MAXFONT
04000 GO RPGLOSE
04100 CALL(RPGFNT)
04200 GO [OUTSTR[ASCIZ/BAD FONT FILE
04300 /]↔ GO SA]
04400 OUTSTR [ASCIZ/XAP INITIALIZED IN RPG MODE.
04500 /]
04600 GO RPGCON]
04700 ;INITIALIZE XGP BUFFER.
04800 restar: CALL(DEFONT)↔GO .-1
04900 CALL(INITXT)↔GO .-1
05000 RPGCON: SETZM TTYFLAG
05100 CALL(MKBUF)
00100 ;Character Loop
00200 LACI =100↔DAC ROWMIN↔DAC ROW
00300 LACI ROWEND-=200↔DAC ROWMAX
00400 LACI =100↔DAC LMAR↔DAC COL
00500 LACI COLEND↔DAC RMAR
00600 L2: CALL(GETCHR)
00700 GO FINISH ;EOF.
00800 JUMPE 1,L2 ;NULL.
00900 CAIN 1,11↔GO[LAC COL↔SUB LMAR↔IDIV DCOL ;TAB.
01000 ANDCMI 7↔ADDI 8↔IMUL DCOL↔ADD LMAR
01100 DAC COL↔GO L2]
01200 CAIN 1,15↔GO[LAC LMAR↔DAC COL↔GO L2] ;RETURN.
01300 CAIN 1,14↔GO[FORMFEED: CALL(XGPOUT) ;FF.
01400 LAC ROWMIN↔DAC ROW
01500 LAC LMAR↔DAC COL↔GO L2]
01600 CAIN 1,40↔GO[SPACE: LAC DCOL↔ADDM COL↔GO COLCHK];SPACE.
01700 CAIN 1,12↔GO[LAC DROW↔ADDM ROW↔GO ROWCHK] ;LINE FEED
01800 CAIN 1,177↔GO ESC1 ;B.S. (default special char.)
01900
02000 ;FONT TABLE LOOKUP AND PLACE CHARACTER'S GLYPH INTO XGP BUFFER.
02100 HIDDEN: HRRE 0,$(1)
02200 JUMPLE SPCHAR↔ADDI $
02300 CALL(PLAG,0)
02400
02500 ;COLUMN OVERFLOW - DEFAULT CRLF.
02600 COLCHK: LAC COL↔CAMLE RMAR↔GO[LAC LMAR↔DAC COL↔LAC DROW
02700 ADDM ROW↔GO ROWCHK]
02800 ROWCHK: LAC ROW↔CAMGE ROWMAX↔GO L2↔GO FORMFEED ;ROW OVERFLOW.
02900
03000 FINISH: CALL(XGPOUT)↔CALLI 0 ;FLUSH BUFFERS
03100 MOVE JOBFF
03200 CORE↔OUTSTR[ASCIZ/COULDN'T SHRINK CORE/] ;AND THEIR CORE
03300 MOVEI 1,MAXFONT
03400 FINIS2: MOVE FONTAB(1)↔ATTSEG↔JFCL↔SETZ↔CORE2
03500 JFCL↔SOJGE 1,FINIS2 ;FLUSH UPPER(S)
03600 CALLI 12 ;EXIT
03700
03800 ;A COMMAND CHARACTER, INTERPET IT
03900 SPCHAR:
04000 ADDI SPTABEND
04100 MOVE @0
04200 JRST @0
04300 SPTABL:
04400 ESC1 ;-1 BINARY FORM OF ESCAPE
04500 SPTABE: [MOVE $+" "
04600 MOVEM $(1)
04700 OUTSTR[ASCIZ/UNDEFINED CHARACTER:/]
04800 CALL(ONECHR)
04900 CRLF
05000 JRST SPACE] ; 0 UNDEFINED CHARACTER
05100
05200 ESC1: CALL(GETCHM)
05300 SKIPE ESC1TB(1)
05400 JRST @ESC1TB(1)
05500 OUTSTR [ASCIZ/UNDEFINED COMMAND:/]
05600 CALL(ONECHR)
05700 CRLF
05800 JRST L2
00100 ;Escape character table;
00200
00300 ESC1TB: HIDDEN ;CENTER DOT
00400 0↔0↔0↔0↔0↔0↔0 ;0-6 ↓αβ∧¬επ
00500 [CALL(DEFONT) ;7 λ (DEFINE A FONT)
00600 GO [OUTSTR[ASCIZ/FONT NOT FOUND.
00700 /]↔ GO L2]
00800 GO L2]
00900 HIDDEN↔0↔HIDDEN↔HIDDEN↔HIDDEN ;11-15 (HIDDEN CHARACTERS)
01000 0↔0 ;16-17 ∞∂
01100 [MOVEI 2↔GO PARTPG] ;20 ⊂ (1/2 PAGE)
01200 [OUTSTR[ASCIZ/CAN'T CROSS PAGE BOUNDARIES, SORRY/]
01300 MOVE DROW↔ADDM ROW↔GO ROWCHK] ;21 ⊃
01400 [MOVEI 3↔IMUL DROW↔ADDM ROW
01500 GO ROWCHK] ;22 ∩ (3 LINES)
01600 [MOVEI 3↔GO PARTPG] ;23 ∪ (1/3 PAGE)
01700 [MOVEI 6↔GO PARTPG] ;24 ∀ (1/6 PAGE)
01800 0↔[PUSHJ P,IIISIM↔JFCL↔GO L2]↔0 ;25-27 ∃⊗↔
01900 0↔0↔0↔0↔0↔0↔0↔0 ;30-37 _→~≠≤≥≡∨
02000 [PUSHJ P,SXINC↔GO COLCHK] ;40 (SPACE, INC X POS)
02100 0↔0↔0↔0↔0↔0↔0 ;41-47 !"#$%&'
02200 0↔0↔0↔0↔0↔0↔0↔0 ;50-57 ()*+,-./
02300 CHGFNT↔CHGFNT↔CHGFNT↔CHGFNT ;60-63 0123 (SET FONT NUMBER)
02400 CHGFNT↔CHGFNT↔CHGFNT↔CHGFNT ;64-67 4567 (SET FONT NUMBER)
02500 CHGFNT↔CHGFNT ;70-71 89 (SET FONT NUMBER)
02600 0↔0↔0↔0↔0↔0 ;72-77 :;<=>?
02700 REQFIL↔0↔0↔0↔0↔0↔0↔0 ;100-107 @ABCDEFG
02800 0↔IVECT↔0↔0↔0↔SETMAR↔0↔0 ;110-117 HIJKLMNO
02900 PVECT↔0↔0↔0↔0↔0↔VECT↔0 ;120-127 PQRSTUVW
03000 0↔0↔0↔0↔0↔0↔0↔0 ;130-137 XYZ[\]↑←
03100 0↔0↔0↔0↔0↔0↔0↔0 ;140-147 `abcdefg
03200 0↔0↔0↔0↔0↔0↔0↔0 ;150-157 hijklmno
03300 0↔0↔0↔0↔0↔0↔0↔0 ;160-167 pqrstuvw
03400 0↔0↔0↔0 ;170-173 xyz{
03500 0↔L2↔0 ;174-176 |~}
03600 [CALL (GETCHM)↔ADD COL↔JUMPL L2
03700 MOVEM COL↔GO L2] ;177
03800
03900 ;SPACE PART OF PAGE DOWN
04000 PARTPG: MOVE 1,ROW↔SUB 1,ROWMIN↔IMUL 1,0↔MOVE 3,ROWMAX
04100 SUB 3,ROWMIN↔IDIV 1,3↔ADDI 1,1↔IMUL 1,3↔IDIV 1,0
04200 ADD 1,ROWMIN↔MOVEM 1,ROW↔GO ROWCHK
04300
04400 ;INC. POSITION
04500 SXINC: CALL(GETCHM)↔ADDM 1,COL↔POPJ P,
04600 SYINC: CALL(GETCHM)↔ADDM 1,ROW↔POPJ P,
04700
04800 ;SWITCH FONTS
04900 CHGFNT: CAILE 1,MAXFONT+"0"↔GO[OUTSTR[ASCIZ/ILLEGAL FONT NUMBER:/]
05000 CALL(ONECHR)↔GO L2]
05100 SKIPE 2,FONTAB-"0"(1)
05200 GO [DETSEG
05300 ATTSEG 2,↔GO[OUTSTR[ASCIZ/OOPS, MY SEGMENT WENT AWAY!/]
05400 HALT .+1]
05500 CALL(SETFNT)↔GO L2]
05600 OUTSTR [ASCIZ/UNDEFINE CHARACTER SET #/]
05700 OUTCHR 1
05800 GO L2
05900
06000 ;INDIRECT FILE
06100 REQFIL: CALL(INITXT)↔GO[OUTSTR[ASCIZ/REQUIRED TEXT FILE NOT FOUND
06200 /]↔GO L2]
06300 OUTSTR[ASCIZ/REQUIRE TEXT COMMAND SEEN.
06400 /]↔ GO L2
06500
06600 ;SET MARGINS
06700 SETMAR: CALL(GETCHM)↔MOVE 3,1↔CALL(RDNUM)
06800 JUMPL 1,BADMAR
06900 CAIN 3,"L"↔GO[CAML RMAR↔GO BADMAR↔MOVEM LMAR↔MOVEM COL↔GO L2]
07000 CAIN 3,"R"↔GO[CAIG 1,COLEND↔CAMG LMAR↔GO BADMAR↔MOVEM RMAR↔GO L2]
07100 CAIN 3,"T"↔GO[CAML ROWMAX↔GO BADMAR↔MOVEM ROWMIN↔CAML ROW
07200 MOVEM ROW↔GO L2]
07300 CAIN 3,"B"↔GO[CAIG ROWEND↔CAMG ROWMIN↔GO BADMAR↔MOVEM ROWMAX
07400 CAML ROW↔GO L2↔GO FORMFEED]
07500 BADMAR: OUTSTR[ASCIZ/ILLEGAL MARGIN COMMAND /]↔OUTCHR 3↔CRLF↔GO L2
07600
07700
07800 VECT: CALL(RDPAIR)↔GO VLOSE↔CALL(PLTVEC,3,0)↔GO L2
07900 IVECT: CALL(RDPAIR)↔GO VLOSE↔MOVEM 3,COL↔MOVEM ROW↔GO L2
08000 PVECT: CALL(RDPAIR)↔GO VLOSE↔MOVEM 3,COL↔MOVEM ROW↔CALL(PLTVEC,3,0)
08100 GO L2
08200 VLOSE: OUTSTR[ASCIZ/VECTOR OFF SCREEN
08300 /]↔ GO L2
00100 ;A Storage Area
00200 RMAR: COLEND
00300 LMAR: =100
00400 ROWMIN: =100
00500 ROWMAX: ROWEND
00600
00700 FILNAM: 0 ;FILE NAME.
00800 EXTION: 0 ;EXTENSION.
00900 0
01000 PPPN: 0 ;PROJECT-PROGRAMMER.
01100 0
01200 FNTPPN: SIXBIT/XGPTVR/ ;DEFAULT FONT PPN
01300
01400 IOPTR: 0 ;POINTER INTO FILE STACK
01500 IBUF: BLOCK 4*MAXFILES ;FILE STACK
01600 CHANTB←IBUF+3
01700
01800 TTYFLA: 0 ;INPUT FROM TTY
01900 RPGSW: 0
02000
02100 FONTNO: 0
02200 FONTAB: BLOCK =10
02300
02400 PDL: BLOCK 100 ;CONTROL PUSH DOWN.
02500 PAT: BLOCK 100 ;PATCH AREA.
00100 COMMENT ∞ Short Desription of Extended Functions for XAP.
00200
00300 These commands are preceded with '177 (or equivalent).
00400
00500 The escape characters which print hidden characters on LPT will
00600 output the same characters on the XGP if they are defined in the
00700 character set currently being used. The line spacing commands
00800 for the LPT should also do the same on the XGP with the exception
00900 of '177 '21 (line space over page boundary).
01000
01100 0-9 Select character set number specified by digit.
01200 λ<file>→<digit> Define character set number and load set into upper
01300 segment.
01400 <space><char.> Takes octal value of character to be number of bits
01500 to move right.
01600 <rubout><char.> Takes octal value of character to be number of bits
01700 to move left.
01800 MR<number> Set Right margin to <number> (in XGP co-ordinates).
01900 ML<number> Set Left margin to <number> (in XGP co-ordinates).
02000 MB<number> Set Bottom margin to <number> (in XGP co-ordinates).
02100 MT<number> Set Top margin to <number> (in XGP co-ordinates).
02200 V<number><number> Visible vector to <number>,<number> (in XGP points).
02300 I<number><number> Invisible vector to <number>,<number> (in XGP points).
02400 P<number><number> Point vector to <number>,<number> (in XGP points).
02500 <altmode> No-op (when placed in text, if not deleted explicitly
02600 protects a line from being changed by TV or E).
02700 @<file><crlf> Inserts file at this point in listing.
02800 ⊗<char><file><crlf> Inserts III buffer at this point in file, relocated
02900 by current position and multiplied by char/64. When
03000 finished leaves cursor at same position.
03100 <number> Defined by two character. Equal to:
03200 (CHAR1-'100)*'200+CHAR2. A SAIL procedure to generate
03300 a number would be:
03400 STRING PROCEDURE MAKNUM(INTEGER X);
03500 RETURN((X % 200)+'100 & (X LAND '177));
03600
03700 RPG Mode:
03800 Start at starting address + 1 with:
03900 4:7 Text file name↔ extesion↔ 0↔ ppn
04000 10:13 Font file name↔ extesion↔ 0↔ ppn (must be completely specified)
04100 14 Font number for font
04200
04300 ∞;
04400 END SA